home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1995 October / EnigmA AMIGA RUN 01 (1995)(G.R. Edizioni)(IT)[!][issue 1995-10][Aminet 7].iso / Aminet / comm / fido / XPACK275.lha / rexx / XPACK.rexx < prev    next >
OS/2 REXX Batch file  |  1995-04-17  |  20KB  |  549 lines
  1. /**/
  2. v="$VER: XPack Rexx   Multi-FTN Archiver-Router-Scheduler  Williamson  54.27"
  3. /*
  4.  Processes 5D FSC-0039 .?U(T|0-9) files as produced by ConfMail 1.13d and
  5.  OutboundMGR.rexx
  6.  Based upon PackMgr.rexx by Robert Williamson
  7.  which was Based on Jbundle by James McOrmond
  8.  which was Based on FidoInOut by Russell McOrmond
  9.  This version is for xferq.library > 1.8 and WPL Mailers > v0.97
  10.  
  11.     Usage:
  12.         Xpack               - will scan defined outbound directory
  13.         Xpack outfilename   - processes specified ?U(T|0-9) file
  14.         Xpack pattern       - processes ?U(T|0-9) files matching pattern
  15. */
  16.  
  17.         xpackcfg ="CFG:Xpack.CFG"
  18.  
  19.     /* Archivers - Note a space MUST follow the command string  */
  20.  
  21.         ARC= "Arc mw "                ; arc.wild="*"
  22.         ZOO= "Zoo aq:M "              ; zoo.wild="*"
  23.         ZHO= "Zoo ahq:M "             ; zho.wild="*"
  24.         ZIP= "Zip -m -q -k -j "       ; zip.wild="*"
  25.         LZH= "Lha -u -P-5 m "         ; lzh.wild="#?"
  26.         LHA= "Lha -2 -u -P-5 m "      ; lha.wild="#?"
  27.  
  28. debugcfg=0
  29. debug=0
  30. TRUE=1;FALSE=0
  31. options results
  32. options failat 99
  33. Numeric digits 8
  34. signal on syntax
  35. signal on halt
  36. signal on break_c
  37. signal on break_d
  38.  
  39. if ~show('L', "rexxsupport.library") then
  40.     if ~addlib("rexxsupport.library",0,-30,0) then do
  41.         say "Couldn't access support.library !"
  42.         exit 20
  43.     end
  44. if ~show('L', "rexxdossupport.library") then
  45.     if ~addlib("rexxdossupport.library",0,-30,2) then do
  46.         say "Couldn't access WB2 rexxdossupport.library !"
  47.         exit 20
  48.     end
  49. if ~show('L', "xferq.library") then
  50.     if ~addlib("xferq.library",0,-30,0) then do
  51.         say "Couldn't access xferq.library !"
  52.         exit 20
  53.     end
  54.  
  55.     /* Find WPL function portname */
  56.     roofsys=show("P","ROOF1")
  57.     call SetClip('ACTIVITY','Routing and packing')
  58.     call pragma("W","NULL")
  59.     call pragma('P','-1')
  60.     log=show('P','ROOFLOG')
  61.     sv="v"right(v,5);script ='XPack'
  62.  
  63.     /* set default host */
  64.     myaddress.pointnet=GetClip('POINTNET')
  65.     myaddress.domain=GetClip('DOMAIN')
  66.     cfgaddress=GetClip('HOST.ADDRESS.'myaddress.domain)
  67.     parse var cfgaddress myaddress.zone ":" myaddress.net "/" myaddress.node "." myaddress.point
  68.  
  69.     OUTSPEC=".(O|C|H|D|N)U?"
  70.  
  71.     dosched=GetClip('POLLONEXPORT') == 'TRUE'
  72.     rpath =addslash(dequote(GetClip('REXXDIR')))
  73.     OUTDIR=addslash(dequote(GetClip('OUTDIR')))
  74.     PKMDIR=addslash(dequote(GetClip('PKMDIR')))
  75.     PKTDIR=addslash(dequote(GetClip('PKTDIR')))
  76.  
  77.     pktspec ="CFG:packet_spec"    /* last packet filename used */
  78.  
  79.     XQ_NOTHING     =0     /* not documented                        */    
  80.     XQ_DELETE      =1     /* Delete file after sending             */
  81.     XQ_TRUNCATE    =2     /* Truncate file after sending           */
  82.     XQ_IMMEDIATE   =4     /* Send only if session currently up     */
  83.     XQ_SENDLATER   =8     /* Make eligible after session goes down */
  84.     XQ_IFSENT      =16    /* Delete IMMEDIATE only if sent         */
  85.  
  86.     DTPRI_CRASH    =50    /* Crash Mail will be called immediatly */
  87.     DTPRI_DIRECT   =30    /* Direct mail will be SCHEDULED        */
  88.     DTPRI_NORM     =0
  89.     DTPRI_HOLD     =-50   /* HOLD for PICKUP                      */
  90.  
  91.     wn=NULL
  92.  
  93.     if debug then wspec='CON:0/10/640/100/ROOF 'script sv'/CLOSE/WAIT'
  94.         else wspec='RAW:0/10/640/100/ROOF 'script sv'/INACTIVE/AUTO/SCREEN'GetClip('SCREEN') 
  95.     call close('STDOUT');call open('STDOUT',wspec,'W');call close('STDIN');call open('STDIN','*','R')
  96.  
  97.     if upper(OUTDIR)=Upper(PKMDIR) then do
  98.         PutLog('CONFIG ERROR: PKMDIR ('PKMDIR') same as OUTDIR') 
  99.         exit 20
  100.     end
  101.     if upper(OUTDIR)=Upper(PKMDIR) then do
  102.         PutLog('CONFIG ERROR: PKTDIR ('PKTDIR') same as OUTDIR') 
  103.         exit 20
  104.     end
  105.     call makedirs(PKTDIR,PKMDIR,PKMDIR"none/")
  106.  
  107.     scandirs=1
  108.     if arg() ~= 0 then do
  109.         parse arg outfile .
  110.         if index(outfile,":")>0 | index(outfile,"/")>0 then do
  111.             OUTDIR=get_path(outfile)
  112.             outfile=get_fn(outfile)
  113.         end    
  114.         if index(outfile,"#?")=0 then do
  115.             tonode.numnodes=readcfg()
  116.             call routemail()
  117.         end;else do
  118.             PutLog('Checking 'OUTDIR' for 'outfile||OUTSPEC' files',10,10)
  119.             address COMMAND 'List >T:out.temp' OUTDIR||outfile||outspec' LFORMAT "%N"'
  120.             call findouts
  121.         end
  122.     end;else do
  123.         PutLog('Checking 'OUTDIR' for *'outspec' files',10,10)
  124.         address COMMAND 'List >T:out.temp' OUTDIR'#?'outspec' LFORMAT "%N"'
  125.         call findouts
  126.     end
  127.  
  128.     do ix=1 to scandirs-1
  129.         PutLog('Packing:' toroute.ix index.ix,60,10)
  130.         if pack(toroute.ix,index.ix) & roofsys then call schedule(index.ix) 
  131.     end
  132.  
  133.     if ~roofsys then address "AREXX" rpath"SHELTER POLL"
  134.     call XfqClose()
  135.     call cleanup
  136.     PutLog('Session completed',10,10)
  137.  exit
  138.  
  139. findouts:
  140.     if debug then address command 'type t:out.temp' 
  141.     if ~exists('T:out.temp') | word(statef('T:out.temp'),2) < 2 | ~open('olist','T:OUT.TEMP','r') then do
  142.         PutLog('No mail to pack',10,10)
  143.         exit
  144.     end
  145.     tonode.numnodes=readcfg()
  146.     do while ~eof('olist')
  147.         outfile=readln('olist')
  148.         if outfile="" then iterate
  149.         call routemail()
  150.     end
  151.     call close('olist')
  152.     call delete('T:out.temp')
  153. return
  154.  
  155. routemail:
  156.     parse var outfile d '.' z '.' n '.' f '.' p '.' type
  157.  
  158.     utext=upper(substr(type,1,2))
  159.     if index("OU CU DU HU NU",utext)=0 then do
  160.         call PutLog(outfile' not 5D mail',10,10)
  161.         return FALSE
  162.     end
  163.     outadr=upper(d'#'z':'n'/'f'.'p)
  164.  
  165.     if upper(type)="CUT" then signal crashpkt
  166.  
  167.     tmpadr=upper(d'#'z':'n'/'f'.'p)
  168.     PutLog('TmpAdr:'tmpadr,60,60)
  169.     do idx=1 until idx=tonode.numnodes
  170.         foradr=upper(fromnode.idx.domain'#'fromnode.idx.zone":"fromnode.idx.net"/"fromnode.idx.node"."fromnode.idx.point)
  171.         if fromnode.idx.zone="?" | fromnode.idx.zone="#?" then do
  172.           tstadr=fromnode.idx.domain"#?:"fromnode.idx.net"/"fromnode.idx.node"."fromnode.idx.point
  173.         end;else do
  174.           tstadr=fromnode.idx.domain"?"fromnode.idx.zone":"fromnode.idx.net"/"fromnode.idx.node"."fromnode.idx.point
  175.         end
  176.         PutLog('TstAdr:'tstadr,60,60)
  177.         if MatchPattern(tstadr,tmpadr,"N") then signal routeit  
  178. /*        token=ParsePattern(tstadr,'N')  */
  179. /*say testadr token */
  180. /*        if MatchPattern(token,tmpadr,"P","N") then signal routeit */
  181.     end
  182.     /* no match ! */
  183.     PutLog('No routing configuration for 'tmpadr,10,10)
  184.  
  185. crashpkt:
  186.     PutLog('Processing non-configured node',10,10)
  187.     route_dirname=PKTDIR
  188.     Parse var outfile node.domain"."node.zone"."node.net"."node.node"."node.point"."junk
  189.     PutLog('Processing' outfile 'for' node.domain'#'node.zone':'node.net'/'node.node'.'node.point,50,10)
  190.     if substr(junk,2,1)="U" then do
  191.         if Left(junk,1)= "C" then node.PRI=DTPRI_CRASH+1
  192.         if Left(junk,1)= "H" then node.PRI=DTPRI_HOLD+1
  193.         if Left(junk,1)= "D" then node.PRI=DTPRI_DIRECT+1
  194.         if Left(junk,1)= "O" then node.PRI=DTPRI_NORM+1
  195.         asfile=get_packetname()
  196.     end;else do
  197.         asfile=outfile
  198.         node.PRI=DTPRI_NORM+1
  199.     end
  200.     PutLog("Moving "outfile "to" route_dirname,60,10)
  201.     call rename(OUTDIR||outfile,route_dirname||outfile)
  202.  
  203.     site=node.domain"#"node.zone":"node.net"/"node.node"."node.point
  204.  
  205.     note="To:" site "File:" asfile
  206.     Address COMMAND 'FileNote' route_dirname||outfile '"'note'"'
  207.     PutLog('Queueing 'route_dirname||outfile' as 'asfile' to 'node.zone'.'node.net'.'node.node'.'node.point' Pri:'node.PRI,50,10)
  208.     QUERY.XQ_SITE=XfqGetAddress(site)
  209.     QUERY.XQ_NAME=route_dirname||outfile
  210.     wn=XfqFindWork(QUERY)
  211.     if (wn=NULL) then call XfqAddWorkQuick(site,route_dirname||outfile,asfile,node.PRI,XQ_DELETE)
  212.     else do
  213.         call XfqUnlockWork(wn)
  214. /*        call XfqDropObject(wn)    */
  215.     end
  216.     call XfqFlushQueue(QUERY.XQ_SITE)
  217.     call XfqDropObject(QUERY.XQ_SITE)
  218.     if (wn~=NULL) then call PutLog("ERR: CrashPkt wn "wn" not NULL",10,10)
  219. return 0
  220.  
  221. routeit:
  222.     if tonode.idx.domain="@" then do
  223.         DirectSite=1;route_via_adr=d"#"z":"n"/"f"."p
  224.         PutLog('Routit DirectSite:'route_via_adr,10,10)
  225.     end;else do
  226.         DirectSite=0;route_via_adr=tonode.idx.domain"#"tonode.idx.zone":"tonode.idx.net"/"tonode.idx.node"."tonode.idx.point
  227.         PutLog('Routit RouteVia:'route_via_adr,10,10)
  228.     end
  229.     if tonode.idx.ARCHIVER="none" then do
  230.         route_via_node="none" /* directory for non-archived mail */
  231.         route_dirname=PKTDIR"none"
  232.     end;else do
  233.         route_via_node=translate(route_via_adr,'...','#:/')
  234.         route_dirname=PKMDIR||route_via_node
  235.     end
  236.  
  237.     PutLog('Routing' OUTDIR||outfile 'for' outadr 'via' route_via_adr 'in' route_dirname,60,10)
  238.     call makedir(route_dirname)
  239.     call rename(OUTDIR||outfile,route_dirname"/"outfile)
  240.     toroute.scandirs=route_dirname
  241.     index.scandirs=idx
  242.     PutLog('Added dir:'toroute.scandirs 'Cfg:'idx,60,10)
  243.     scandirs=scandirs+1
  244. return 0
  245.  
  246. pack:
  247. route_dirname=upper(arg(1))
  248. idx=arg(2)
  249. route_via_node=substr(route_dirname,lastpos('/',route_dirname)+1)
  250. parse var route_via_node d '.' z '.' n '.' f '.' p
  251. foradr=d"#"z":"n"/"f"."p
  252.  
  253. DirectSite=(tonode.idx.domain=="@")
  254.  
  255. PutLog("Creating ARCmail name for "foradr,60,10)
  256. PutLog('Archiver:'tonode.idx.archiver 'Pri:'pri.idx tonode.idx.pri,60,10)
  257. pkt_list=showdir(route_dirname'/','f')
  258. PutLog(route_dirname ":" pkt_list,60,10)
  259. if words(pkt_list)=0 then do
  260.     PutLog('Directory:'route_dirname' is empty',10,10)
  261.     return FALSE
  262. end
  263.  
  264. if DirectSite then do
  265. arcmailname=uniquearc(upper(OUTDIR||route_via_node"."),d"#"z":"n"/"f"."p)
  266. PutLog('DirectSite ARCmail:'arcmailname 'for' foradr '@' d"#"z":"n"/"f"."p,60,10)
  267. end;else do
  268. arcmailname=uniquearc(upper(OUTDIR||route_via_node"."),tonode.idx.domain"#"tonode.idx.zone":"tonode.idx.net"/"tonode.idx.node"."tonode.idx.point)
  269. PutLog('RouteVia ARCmail:'arcmailname 'for' foradr '@' tonode.idx.domain"#"tonode.idx.zone":"tonode.idx.net"/"tonode.idx.node"."tonode.idx.point,60,10)
  270. end
  271.  
  272. if words(pkt_list) > 1 & tonode.idx.archiver ~= "none" then do
  273.     /* rename out files to packets */
  274.     Do wordcount=1 to words(pkt_list)
  275.         outfilename=upper(word(pkt_list,wordcount))
  276.         pktname=get_packetname()
  277.         PutLog('Archiving:' outfilename 'in' arcmailname 'as' pktname,10,10)
  278.         call rename(route_dirname'/'outfilename, route_dirname'/'pktname)
  279.     end
  280.     if DirectSite then tmparcname=strip(OUTDIR"tmp_"d"_"z"_"n"_"f"_"p"."left(ARCHIVER.idx,3))
  281.     else tmparcname=strip(OUTDIR"tmp_"tonode.idx.domain"_"tonode.idx.zone"_"tonode.idx.net"_"tonode.idx.node"_"tonode.idx.point"."left(ARCHIVER.idx,3))
  282.     arcmd=tonode.idx.ARCHIVER||tmparcname route_dirname"/#?"
  283.     call arcit
  284. end;else do
  285.     Do wordcount=1 to words(pkt_list)
  286.         outfilename=upper(word(pkt_list,wordcount))
  287.         pktname=get_packetname()
  288.         if tonode.idx.archiver="none" then do
  289.             PutLog('No Archiver, adding 'outfilename' as 'pktname,10,10)
  290.             QUERY.XQ_NAME=route_dirname"/"outfilename 
  291.             f=XQ_DELETE
  292.             wn=XfqFindWork(QUERY)
  293.             if (wn=NULL) then call XfqAddWorkQuick(site,QUERY.XQ_NAME,pktname,tonode.idx.pri,f)
  294.                 else call XfqUnlockWork(wn)
  295.             signal xfqcleanup
  296.         end;else do
  297.             PutLog('Archiving:' outfilename 'in' arcmailname 'as' pktname,10,10)
  298.             call rename(route_dirname'/'outfilename, route_dirname'/'pktname)
  299.             if DirectSite then tmparcname=strip(OUTDIR"tmp_"d"_"z"_"n"_"f"_"p"."left(ARCHIVER.idx,3))
  300.             else tmparcname=strip(OUTDIR"tmp_"tonode.idx.domain"_"tonode.idx.zone"_"tonode.idx.net"_"tonode.idx.node"_"tonode.idx.point"."left(ARCHIVER.idx,3))
  301.             arcmd=tonode.idx.ARCHIVER||tmparcname route_dirname"/"pktname
  302.             call arcit
  303.         end
  304.     end
  305. end
  306. if (wn ~= NULL) then do
  307.     PutLog("Requeueing old ARCmail",60,10)
  308.     call XfqUnlockWork(wn)
  309.     wn=NULL
  310. end;else do
  311.     PutLog("Adding new ARCmail",60,10)
  312.     /* set myaddress to one in tonode.idx.domain */
  313.     if DirectSite then do
  314.         myaddress.domain=d
  315.         PutLog('Add ArcMail DirectSite domain:'d,60,10) 
  316.     end;else do
  317.         myaddress.domain=tonode.idx.domain
  318.         PutLog('Add ArcMail RouteVia domain:'tonode.idx.domain,60,10)
  319.     end
  320.     cfgaddress=GetClip('HOST.ADDRESS.'myaddress.domain)
  321.     parse var cfgaddress myaddress.zone ":" myaddress.net "/" myaddress.node "." myaddress.point
  322.     PutLog("Host: "myaddress.domain'#'myaddress.zone':'myaddress.net'/'myaddress.node'.'myaddress.point' PointNet' myaddress.pointnet,40,10)
  323.     if DirectSite then do
  324.         if ((n=myaddress.net) & (f=myaddress.node)) then asname=UPPER(d2x(65536+myaddress.net-myaddress.pointnet,4)||d2x(65536+myaddress.node-p,4)||right(arcmailname,4))
  325.         else asname=UPPER(d2x(65536+myaddress.net-n,4)||d2x(65536+myaddress.node-f,4)||right(arcmailname,4))
  326.         PutLog('DirectSite AsName:'asname,60,10)
  327.     end;else do
  328.         if ((tonode.idx.node=myaddress.node) & (tonode.idx.net=myaddress.net)) then asname=UPPER(d2x(65536+myaddress.net-myaddress.pointnet,4)||d2x(65536+myaddress.node-tonode.idx.point,4)||right(arcmailname,4))
  329.         else asname=UPPER(d2x(65536+myaddress.net-tonode.idx.net,4)||d2x(65536+myaddress.node-tonode.idx.node,4)||right(arcmailname,4))
  330.         PutLog('RouteVia AsName:'asname,60,10)
  331.     end
  332.     PutLog('Queueing:'arcmailname'['asname'] for 'foradr' Pri:['tonode.idx.PRI']',50,10)
  333.     note="To: "foradr "File: "asname 
  334.     Address COMMAND 'FileNote' arcmailname '"'note'"'
  335.     call XfqAddWorkQuick(site,arcmailname,asname,tonode.idx.pri,XQ_DELETE)
  336. end
  337.  
  338. xfqcleanup:
  339.     call XfqDropObject(wn)
  340.     call XfqFlushQueue(QUERY.XQ_SITE)
  341.     call XfqDropObject(QUERY.XQ_SITE)
  342.     if (wn~=NULL) then call PutLog("ERR: XFQcleanup wn "wn" not NULL",10,10)
  343.     PutLog('Deleting if empty 'route_dirname,60,10)
  344.     call delete(route_dirname)
  345. Return TRUE
  346.  
  347. arcit:
  348.     if (EXISTS(arcmailname)) then do
  349.         PutLog("Renaming:"arcmailname "to" tmparcname,70,50)
  350.         call rename(arcmailname,tmparcname)
  351.     end
  352.     Address Command arcmd
  353.     if RC ~= 0 then PutLog('Command 'arcmd' failed:'RC,10,10)
  354.     PutLog("Renaming:"tmparcname "to" arcmailname,70,50)
  355.     call rename(tmparcname,arcmailname)
  356. return
  357.  
  358. schedule:
  359.     /* Schedule call */
  360.     idx=arg(1)
  361.     if DirectSite then do
  362.          q_adrs=d'#'z':'n'/'f'.'p
  363.     end;else do
  364.         q_adrs=tonode.idx.domain'#'tonode.idx.zone':'tonode.idx.net'/'tonode.idx.node'.'tonode.idx.point
  365.     end
  366.     select
  367.         when tonode.idx.PRI=DTPRI_HOLD then call PutLog('HOLDing 'q_adrs' Pri:'tonode.idx.PRI,10,10)
  368.         when ((tonode.idx.PRI > DTPRI_HOLD) & (tonode.idx.PRI < DTPRI_CRASH)) then do
  369.             PutLog('SCHEDuling 'q_adrs' Pri:'tonode.idx.PRI,10,10)
  370.             Address "FLOWMGR" "RESCHED" "'"q_adrs"'"
  371.             return 0
  372.         end
  373.         when tonode.idx.PRI=DTPRI_CRASH then do
  374.             PutLog('CRASHing 'q_adrs' Pri:'tonode.idx.PRI,10,10)
  375.             if ~roofsys then Address "AREXX" rpath'SCALL.rexx' q_adrs
  376.             else do
  377.                 if exists("RPDIR:CALL") then address COMMAND "Run CALL" q_adrs
  378.                 else do
  379.                     cmd=rpath'CALL.rexx' q_adrs
  380.                     Address "AREXX" cmd
  381.                 end
  382.             end
  383.         end
  384.         otherwise call PutLog('No scheduling action 'q_adrs' Pri:'tonode.idx.PRI,10,10)
  385.     end /*select*/
  386. return 0
  387.  
  388. /* get path */
  389. get_path: procedure
  390.     pos=LastPos('/',arg(1))
  391.     if pos=0 then pos=LastPos(':', arg(1))
  392. Return SubStr(arg(1),1,pos)
  393.  
  394. /* get filename */
  395. get_fn:
  396. if LastPos('/',arg(1))~=0 then return SubStr(arg(1),LastPos('/',arg(1))+1)
  397. else if LastPos(':',arg(1))~=0 then return SubStr(arg(1),LastPos(':',arg(1))+1)
  398. else return arg(1)
  399. /**/
  400.  
  401. get_packetname:
  402.     tspec=left(date(),2)||compress(time(),":")
  403.     if (tspec=packet_spec) then tspec=tspec+1
  404.     do while exists(OUTDIR||tspec".PKT")
  405.         tspec=tspec+1
  406.     end
  407.     if ~open('out',pktspec,'W') then call PutLog("Can't write new packet_spec file",10,10)
  408.     else DO
  409.         writeln('out',tspec)
  410.         close('out')
  411.     END
  412. return(tspec".PKT")
  413.  
  414.  
  415. makedirs:
  416.     do i=1 to arg()
  417.         call makedir(left(arg(i),length(arg(i))-1))
  418.     end
  419. return
  420.  
  421. readcfg:
  422.     if open('in',pktspec,'R') then do
  423.         packet_spec=readln('in')
  424.         close('in')
  425.     end
  426.     PutLog('Reading 'xpackcfg,60,10)
  427.     if ~Open('cfgfile',xpackcfg,'R') then do
  428.         PutLog("Error opening "xpackcfg,10,10)
  429.         call cleanup()  
  430.         Exit 1
  431.     end
  432.  
  433.     i=0
  434.     DO forever
  435.         Line=Upper(strip(space(ReadLn('cfgfile'),1),'B'))
  436.         if EOF('cfgfile') then Leave
  437.         if Left(Line,1)=";" | Line="" then Iterate
  438.         i=i+1
  439.         if pos('@',Line)>0 then parse var Line fromnode.i.domain"#"fromnode.i.zone":"fromnode.i.net"/"fromnode.i.node"."fromnode.i.point" "tonode.i.domain" "archiver.i" "pri.i" "poll.i" "win.i 
  440.         else parse var Line fromnode.i.domain"#"fromnode.i.zone":"fromnode.i.net"/"fromnode.i.node"."fromnode.i.point" "tonode.i.domain"#"tonode.i.zone":"tonode.i.net"/"tonode.i.node"."tonode.i.point" "archiver.i" "pri.i" "poll.i" "win.i 
  441.  
  442.         if left(archiver.i,3)="NON" then TONODE.I.ARCHIVER="none"
  443.             else TONODE.I.ARCHIVER=VALUE(ARCHIVER.I)
  444.         select
  445.             when left(pri.i, 3)="CRA" then TONODE.I.PRI=DTPRI_CRASH
  446.             when left(pri.i, 3)="HOL" then TONODE.I.PRI=DTPRI_HOLD
  447.             when left(pri.i, 3)="DIR" then TONODE.I.PRI=DTPRI_DIRECT
  448.             when left(pri.i, 3)="NOR" then TONODE.I.PRI=DTPRI_NORM
  449.             when datatype(pri.i)="NUM" then TONODE.I.PRI=pri.i
  450.         otherwise TONODE.I.PRI="0"      /*default*/
  451.         end
  452.         if debugcfg then do
  453.             PutLog(fromnode.i.domain"#"fromnode.i.zone":"fromnode.i.net"/"fromnode.i.node"."fromnode.i.point" 'via' "tonode.i.domain"#"tonode.i.zone":"tonode.i.net"/"tonode.i.node"."tonode.i.point,90,10) 
  454.             PutLog('Archiver:'archiver.i TONODE.I.ARCHIVER' Pri:'pri.i TONODE.I.PRI,90,10)
  455.             PutLog('Poll CMD:'poll.i' Windows:'win.i,90,10)
  456.         end
  457.     END
  458.     call Close('cfgfile')
  459. return i
  460.  
  461. PutLog:  procedure expose log script
  462.     if arg(3) < GetClip('STATUSLEVEL') then say arg(1)
  463.     if arg(2) > GetClip('LOGLEVEL') then return 0
  464.     if log then address 'ROOFLOG' 'logline' left(time(),5) script': 'arg(1)
  465. return 0
  466.  
  467. /* a useful procedure by Walt Sullivan    */
  468. dequote:
  469.     parse arg thing
  470.     parse var thing '"' unq_thing '"'
  471.     if unq_thing ~= "" then return unq_thing
  472. return thing
  473.  
  474. addslash:
  475. curr=arg(1)
  476. select
  477.     when right(curr, 1)=":" then nop
  478.     when right(curr, 1)="/" then nop
  479.         otherwise curr=curr"/"
  480. end
  481. return(curr)
  482.  
  483. cleanup:
  484.     call SetClip('ACTIVITY')
  485. return 0
  486.  
  487.  
  488. /*  Error handling */
  489. break_c:
  490. break_d:
  491.     PutLog('User abort',10,10)
  492.     call cleanup
  493.     exit 10
  494.  
  495. /* Miscellaneous utility functions */
  496.  
  497. /* handle references to uninitialized variables by saying which line */
  498. /* and typing the offending line.                                     */
  499. novalue: call template_oops "Novalue" sigl
  500. syntax:  call template_oops "Syntax(RC="RC")" sigl RC
  501. failure: call template_oops "Failure(RC="RC")" sigl
  502. halt:    call template_oops "Halt" sigl 
  503.  
  504. template_oops:
  505. parse arg what badline code
  506. if code~="" then call PutLog("ERR Line:"badline what errortext(code),10,60)
  507. else PutLog("ERR Line:"badline what,10,10)
  508. call xfqcleanup()
  509. call cleanup
  510. exit(40)
  511. /**/
  512.  
  513. uniquearc:
  514.     base=arg(1);site=arg(2)
  515.     i=0
  516.     QUERY.XQ_SITE=XfqGetAddress(site)
  517.     dex=upper(left(date(w),2))
  518.     arcmailname=base||dex||i
  519.     if ~XfqSessionUp(QUERY.XQ_SITE) & ~isaborted(arcmailname) then return arcmailname
  520.     do forever
  521.         PutLog('Checking if' arcmailname 'is queued',20,10)
  522.         QUERY.XQ_NAME=arcmailname
  523.         wn=NULL;wn=XfqFindWork(QUERY)
  524.         if wn~=NULL then do
  525.             i=i+1
  526.             if i>9 then do
  527.                 i=0;dex=upper(left(date('w',date(i)+1),2))
  528.             end        
  529.             arcmailname=base||dex||i
  530.             if isaborted(arcmailname) then iterate
  531.         end;else do
  532.             if ~exists(arcmailname) then return arcmailname
  533.             else do
  534.                 PutLog('ERROR: unqueued 'arcmailname' exists!',10,10)
  535.                 i=i+1
  536.                 arcmailname=base||dex||i
  537.                 if isaborted(arcmailname) then iterate
  538.             end
  539.         end
  540.         if wn~=NULL then call XfqUnlockWork(wn)
  541.     end
  542. return arcmailname
  543.  
  544. isaborted:
  545.     if ~exists(arg(1)) then return 0
  546.     if pos('ABORTED',subword(statef(arg(1)),8))>0 then return 1
  547. return 0
  548.  
  549.